#lang racket

(require "rename-mutable-pair-ops.rkt")

(provide operation-table get put print-table)

(define (assoc key records)
  (cond ((null? records) false)
        ((equal? key (car (car records))) (car records))
        (else (assoc key (cdr records)))))

(define (print-1d-table t)
  (print-list (cdr t)))

(define (make-table)
  (let ((local-table (list '*table*)))
    (define (lookup key-1 key-2)
      (let ((subtable (assoc key-1 (cdr local-table))))
        (if subtable
            (let ((record (assoc key-2 (cdr subtable))))
              (if record
                  (cdr record)
                  false))
            false)))
    (define (insert! key-1 key-2 value)
      (let ((subtable (assoc key-1 (cdr local-table))))
        (if subtable
            (let ((record (assoc key-2 (cdr subtable))))
              (if record
                  (set-cdr! record value)
                  (set-cdr! subtable
                            (cons (cons key-2 value)
                                  (cdr subtable)))))
            (set-cdr! local-table
                      (cons (list key-1
                                  (cons key-2 value))
                            (cdr local-table)))))
      'ok)
    (define (print-table)
      (define (iter subt)
        (cond ((not (null? subt)) (display (car (car subt)))
                                  (display ": ")
                                  (print-1d-table (car subt))
                                  (iter (cdr subt)))))
      (display "[\n")
      (iter (cdr local-table))
      (display "]"))
    (define (dispatch m)
      (cond ((eq? m 'lookup-proc) lookup)
            ((eq? m 'insert-proc!) insert!)
            ((eq? m 'print-table) print-table)
            (else (error "unknown operation -- TABLE: " m))))
    dispatch))

(define operation-table (make-table))

(define get (operation-table 'lookup-proc))

(define put (operation-table 'insert-proc!))

(define (print-table) ((operation-table 'print-table)))